Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH10/SRC/BSPLINE.CLS

Text File | 1996-05-04 | 13KB | 454 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ObjBSpline"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Private DegreeU As Integer  ' Degree in U direction.
Private DegreeV As Integer  ' Degree in V direction.
Private MaxU As Integer     ' Dimensions of control grid.
Private MaxV As Integer
Private Points() As Point3D ' Control points.

' grid holds a refined grid to display the surface.
Private grid As ObjPicture

' u and v increment parameters.
Private GapU As Single
Private GapV As Single
Private Du As Single
Private Dv As Single

' Display flags.
Private ShowControls As Boolean ' Draw control points?
Private ShowGrid As Boolean     ' Draw control grid?

Function Factorial(ByVal n As Single) As Single
Dim i As Integer
Dim tot As Single

    tot = 1
    For i = 2 To n
        tot = tot * i
    Next i
    Factorial = tot
End Function

' ************************************************
' Create the refined grid to display the surface.
' ************************************************
Public Sub InitializeGrid(degu As Integer, degv As Integer, gap_u As Single, gap_v As Single, d_u As Single, d_v As Single)
Dim u As Single
Dim v As Single
Dim stopu As Single
Dim stopv As Single
Dim x As Single
Dim y As Single
Dim z As Single
Dim x1 As Single
Dim y1 As Single
Dim z1 As Single
Dim pline As ObjPolyline

    DegreeU = degu
    DegreeV = degv
    GapU = gap_u
    GapV = gap_v
    Du = d_u
    Dv = d_v

    Set grid = New ObjPicture

    ' Create curves with constant u.
    stopu = MaxU - DegreeU + 2 + GapU / 10
    stopv = MaxV - DegreeV + 2 + Dv / 10
    For u = 0 To stopu Step GapU
        Set pline = New ObjPolyline
        grid.objects.Add pline

        SurfaceValue u, 0, x1, y1, z1

        For v = Dv To stopv Step Dv
            SurfaceValue u, v, x, y, z
            pline.AddSegment x1, y1, z1, x, y, z
            x1 = x
            y1 = y
            z1 = z
        Next v
    Next u

    ' Create curves with constant v.
    stopv = MaxV - DegreeV + 2 + GapV / 10
    stopu = MaxU - DegreeU + 2 + Du / 10
    For v = 0 To stopv Step GapV
        Set pline = New ObjPolyline
        grid.objects.Add pline

        SurfaceValue 0, v, x1, y1, z1
        For u = Du To stopu Step Du
            SurfaceValue u, v, x, y, z
            pline.AddSegment x1, y1, z1, x, y, z
            x1 = x
            y1 = y
            z1 = z
        Next u
    Next v
End Sub
' ************************************************
' Apply a transformation matrix which may not
' contain 0, 0, 0, 1 in the last column to the
' object.
' ************************************************
Public Sub ApplyFull(M() As Single)
Dim i As Integer
Dim j As Integer

    ' Apply the matrix to the grid if it exists.
    If Not grid Is Nothing Then grid.ApplyFull M

    ' Apply the matrix to the control points.
    For i = 0 To MaxU
        For j = 0 To MaxV
            m3ApplyFull Points(i, j).coord, M, Points(i, j).trans
        Next j
    Next i
End Sub
' ************************************************
' Apply a nonlinear transformation.
' ************************************************
Public Sub Distort(D As Object)
Dim i As Integer
Dim j As Integer

    ' Distort the grid if it exists.
    If Not grid Is Nothing Then grid.Distort D

    ' Distort the sparse data.
    For i = 0 To MaxU
        For j = 0 To MaxV
            D.Distort Points(i, j).coord(1), Points(i, j).coord(2), Points(i, j).coord(3)
        Next j
    Next i
End Sub
' ************************************************
' Draw the transformed object on a Form, Printer,
' or PictureBox.
' ************************************************
Public Sub Draw(canvas As Object, Optional r As Variant)
Dim i As Integer
Dim j As Integer

    ' Draw the grid if it exists.
    If Not grid Is Nothing Then grid.Draw canvas, r

    ' Draw the control points if desired.
    If ShowControls Then
        On Error Resume Next
        For i = 0 To MaxU
            For j = 0 To MaxV
                canvas.Line (Points(i, j).trans(1) - 2, Points(i, j).trans(2) - 2)-Step(4, 4), , BF
            Next j
        Next i
    End If

    ' Draw the control grid if desired.
    If ShowGrid Then
        On Error Resume Next
        For i = 0 To MaxU
            canvas.CurrentX = Points(i, 0).trans(1)
            canvas.CurrentY = Points(i, 0).trans(2)
            For j = 1 To MaxV
                canvas.Line -(Points(i, j).trans(1), Points(i, j).trans(2))
            Next j
        Next i
        For j = 0 To MaxV
            canvas.CurrentX = Points(0, j).trans(1)
            canvas.CurrentY = Points(0, j).trans(2)
            For i = 1 To MaxU
                canvas.Line -(Points(i, j).trans(1), Points(i, j).trans(2))
            Next i
        Next j
    End If
End Sub

' ************************************************
' Read a B-Spline surface from a file using Input.
' Assume the "BSPLINE" label has already been
' read.
' ************************************************
Public Sub FileInput(filenum As Integer)
Dim i As Integer
Dim j As Integer

    ' Get the basic information.
    Input #filenum, _
        DegreeU, DegreeV, MaxU, MaxV, GapU, GapV, _
        Du, Dv

    ' Allocate the Data array.
    SetBounds MaxU + 1, MaxV + 1

    ' Read the control points.
    For i = 0 To MaxU
        For j = 0 To MaxV
            Input #filenum, _
                Points(i, j).coord(1), _
                Points(i, j).coord(2), _
                Points(i, j).coord(3)
            Points(i, j).coord(4) = 1
        Next j
    Next i

    ' Initialize the grid data.
    If Du = 0 Then
        Set grid = Nothing
    Else
        InitializeGrid DegreeU, DegreeV, _
            GapU, GapV, Du, Dv
    End If
End Sub




' ************************************************
' Write a B-Spline surface to a file using Write.
' Begin with "BSPLINE" to identify this object.
' ************************************************
Public Sub FileWrite(filenum As Integer)
Dim i As Integer
Dim j As Integer

    ' Write basic information.
    Write #filenum, "BSPLINE", _
        DegreeU, DegreeV, MaxU, MaxV, GapU, GapV, _
        Du, Dv

    ' Write the data.
    For i = 0 To MaxU
        For j = 0 To MaxV
            Write #filenum, _
                Points(i, j).coord(1), _
                Points(i, j).coord(2), _
                Points(i, j).coord(3)
        Next j
    Next i
End Sub
' ************************************************
' Write the B-Spline curve's grid object to a file
' using Write. The data can later be loaded into
' an ObjPicture object but not an ObjBSpline
' object.
' ************************************************
Public Sub FileWriteGrid(filenum As Integer)
    If Not grid Is Nothing Then grid.FileWrite filenum
End Sub

' ***********************************************
' Fix the data coordinates at their transformed
' values.
' ***********************************************
Public Sub FixPoints()
Dim i As Integer
Dim j As Integer
Dim k As Integer

    ' Fix the grid points if the grid exists.
    If Not grid Is Nothing Then grid.FixPoints

    ' Fix the controls points.
    For i = 0 To MaxU
        For j = 0 To MaxV
            For k = 1 To 3
                Points(i, j).coord(k) = _
                    Points(i, j).trans(k)
            Next k
        Next j
    Next i
End Sub

' ************************************************
' Return the knot value.
' ************************************************
Private Function Knot(i As Integer, max As Integer, degree As Integer) As Integer
    If i < degree Then
        Knot = 0
    ElseIf i <= max Then
        Knot = i - degree + 1
    Else
        Knot = max - degree + 2
    End If
End Function


' ************************************************
' Return the value of the blending function Ni,k.
' ************************************************
Private Function NValue(i As Integer, max As Integer, degree As Integer, max_degree As Integer, u As Single) As Single
Dim denom As Single
Dim v1 As Single
Dim v2 As Single

    If degree = 1 Then
        If Knot(i, max, max_degree) <= u And _
         u < Knot(i + 1, max, max_degree) Then
            NValue = 1
        Else
            NValue = 0
        End If

        ' Recall that:
        '   Ni,1(u) = 0     if ti <= u < ti+1
        '             1     otherwise
        ' The following test handles u = tmax.
        If i = max And _
            Knot(i, max, max_degree) <= u And _
            u <= Knot(i + 1, max, max_degree) + 0.001 Then
                NValue = 1
        End If
        Exit Function
    End If

    denom = Knot(i + degree - 1, max, max_degree) - _
        Knot(i, max, max_degree)
    If denom = 0 Then
        v1 = 0
    Else
        v1 = (u - Knot(i, max, max_degree)) * _
            NValue(i, max, degree - 1, max_degree, u) / _
            denom
    End If

    denom = Knot(i + degree, max, max_degree) - _
        Knot(i + 1, max, max_degree)
    If denom = 0 Then
        v2 = 0
    Else
        v2 = (Knot(i + degree, max, max_degree) - u) * _
            NValue(i + 1, max, degree - 1, max_degree, u) / _
            denom
    End If

    NValue = v1 + v2
End Function

' ***********************************************
' Return a string indicating the object type.
' ***********************************************
Property Get ObjectType() As String
    ObjectType = "BSPLINE"
End Property
' ************************************************
' Let the user know if we are drawing the control
' grid.
' ************************************************
Property Get DrawGrid() As Boolean
    DrawGrid = ShowGrid
End Property

' ************************************************
' Let the user know if we are drawing the control
' points.
' ************************************************
Property Get DrawControls() As Boolean
    DrawControls = ShowControls
End Property


' ************************************************
' Let the user decide whether we should draw the
' control grid.
' ************************************************
Property Let DrawGrid(value As Boolean)
    ShowGrid = value
End Property
' ************************************************
' Let the user decide whether we should draw the
' control points.
' ************************************************
Property Let DrawControls(value As Boolean)
    ShowControls = value
End Property




' ************************************************
' Apply a transformation matrix to the object.
' ************************************************
Public Sub Apply(M() As Single)
Dim i As Integer
Dim j As Integer

    ' Apply the matrix to the grid if it exists.
    If Not grid Is Nothing Then grid.Apply M

    ' Apply the matrix to the control points.
    For i = 0 To MaxU
        For j = 0 To MaxV
            m3Apply Points(i, j).coord, M, Points(i, j).trans
        Next j
    Next i
End Sub





' ************************************************
' Set MaxU and MaxV ans allocate room for the
' control points.
' ************************************************
Public Sub SetBounds(NumX As Integer, NumZ As Integer)
    MaxU = NumX - 1
    MaxV = NumZ - 1
    ReDim Points(0 To NumX, 0 To NumZ)
End Sub

' ************************************************
' Set the value for a control point.
' ************************************************
Public Sub SetControlPoint(i As Integer, j As Integer, x As Single, y As Single, z As Single)
    Points(i - 1, j - 1).coord(1) = x
    Points(i - 1, j - 1).coord(2) = y
    Points(i - 1, j - 1).coord(3) = z
    Points(i - 1, j - 1).coord(4) = 1
End Sub
' ************************************************
' Return the value of the B-Spline surface at this
' position.
' ************************************************
Private Sub SurfaceValue(u As Single, v As Single, x As Single, y As Single, z As Single)
Dim p As Integer
Dim i As Integer
Dim j As Integer
Dim pt As Point3D
Dim Ni As Single
Dim Nj As Single

    For i = 0 To MaxU
        ' Compute Ni.
        Ni = NValue(i, MaxU, DegreeU, DegreeU, u)

        For j = 0 To MaxV
            ' Compute Nj.
            Nj = NValue(j, MaxV, DegreeV, DegreeV, v)

            ' Add to the coordinates.
            For p = 1 To 3
                pt.coord(p) = pt.coord(p) + _
                    Points(i, j).coord(p) * _
                    Ni * Nj
            Next p
        Next j
    Next i

    ' Prepare the output.
    x = pt.coord(1)
    y = pt.coord(2)
    z = pt.coord(3)
End Sub